unit uRSACrypt;

interface

uses
  OpenSSLUtils,
  SysUtils,
  libeay32,
  Classes,
  Windows,
  Math,
  HyperStr;

procedure InitOpenSSL;
procedure FreeOpenSSL;
procedure GenerateKeyPair(const AKeyFileNames, APassword: string; const KeySize: Integer);
function Sign_RSA_MD5(privatekey, Password, msg: string): string;
function Sign_RSA_MD5_Base64(privatekey, Password, msg: string): string;
procedure RSAEncryptFile(KeyFile, Password, CleartextFile, CryptedFile: string; padding: Integer = RSA_PKCS1_PADDING);
function RSAEncryptBlock(const AInputBlock: string; ApRSA: pRSA; const APadding: Integer = RSA_PKCS1_PADDING): string;
function RSAEncryptStr(const AKeyFile, APassword, AInputStr: string; const APadding: Integer = RSA_PKCS1_PADDING): string;
function RSADecryptBlock(const AInputBlock: string; ApRSA: pRSA; const APadding: Integer = RSA_PKCS1_PADDING): string;
function RSADecryptStr(const AKeyFile, AInputStr: string; const APadding: Integer = RSA_PKCS1_PADDING): string;

implementation

{
  You must call this procedure before any OpenSSL-related function.
  When you finish, you can clear environment with FreeOpenSSL prodedure.
}

procedure InitOpenSSL;
begin
  OpenSSL_add_all_algorithms;
  OpenSSL_add_all_ciphers;
  OpenSSL_add_all_digests;
  ERR_load_crypto_strings;
end;

{
  Cleanup environment and release memory.
}

procedure FreeOpenSSL;
begin
  EVP_cleanup;
end;

procedure GenerateKeyPair(const AKeyFileNames, APassword: string; const KeySize: Integer);
var
  kp: TKeyPairGenerator;
begin
  try
    kp := TKeyPairGenerator.Create;
    kp.KeyLength := KeySize;
    kp.KeyFileNames(AKeyFileNames);
    // it create a pair $AKeyFileNames.key and $AKeyFileNames.pub
    kp.Password := APassword; // Required
    kp.GenerateRSA;
  finally
    FreeAndNil(kp);
  end;
end;

function Sign_RSA_MD5(privatekey, Password, msg: string): string;
var
  Len: Cardinal;
  mdctx: EVP_MD_CTX;
  inbuf, outbuf: array[0..1023] of Char;
  Key: pEVP_PKEY;
begin
  StrPCopy(inbuf, msg);
  InitOpenSSL;
  Key := ReadPrivateKey(privatekey, Password);
  EVP_SignInit(@mdctx, EVP_md5());
  EVP_SignUpdate(@mdctx, @inbuf, StrLen(inbuf));
  EVP_SignFinal(@mdctx, @outbuf, Len, Key);
  EVP_PKEY_free(Key);
  //EVP_MD_CTX_cleanup(@mdctx); //??
  FreeOpenSSL;
  BinToHex(outbuf, inbuf, Len);
  inbuf[2 * Len] := #0;
  Result := StrPas(inbuf);
end;

function Sign_RSA_MD5_Base64(privatekey, Password, msg: string): string;
var
  Len, i: Cardinal;
  OutStr: string;
  mdctx: EVP_MD_CTX;
  inbuf, outbuf: array[0..1023] of Char;
  Key: pEVP_PKEY;
begin
  StrPCopy(inbuf, msg);
  InitOpenSSL;
  Key := ReadPrivateKey(privatekey, Password);
  EVP_SignInit(@mdctx, EVP_md5());
  EVP_SignUpdate(@mdctx, @inbuf, StrLen(inbuf));
  EVP_SignFinal(@mdctx, @outbuf, Len, Key);
  EVP_PKEY_free(Key);
  //EVP_MD_CTX_cleanup(@mdctx); //??
  FreeOpenSSL;
  //---------------------------------------------------------------------
  OutStr := '';
  for i := 0 to Len do
  begin
    OutStr := OutStr + inbuf[i];
  end;
  Result := EnCodeStr(OutStr);
  //BinToHex(outbuf, inbuf, Len);
  //inbuf[2 * Len] := #0;
  //Result := StrPas(inbuf);
end;

procedure RSAEncryptFile(KeyFile, Password, CleartextFile, CryptedFile: string; padding: Integer = RSA_PKCS1_PADDING);
var
  rsa: pRSA;
  KeySize: Integer;
  Key: pEVP_PKEY;
  cleartext, crypted: pBIO;
  rsa_in, rsa_out: Pointer;
  rsa_inlen, rsa_outlen: Integer;
begin
  InitOpenSSL;
  Key := ReadPrivateKey(KeyFile, Password);
  rsa := EVP_PKEY_get1_RSA(Key);
  EVP_PKEY_free(Key);
  if rsa = nil then
    raise Exception.Create('Error getting RSA key. ' + GetErrorMessage);

  cleartext := BIO_new_file(PChar(CleartextFile), 'rb');
  if cleartext = nil then
    raise Exception.Create('Error Reading Input File. ' + GetErrorMessage);
  crypted := BIO_new_file(PChar(CryptedFile), 'wb');
  if crypted = nil then
    raise Exception.Create('Error Reading Output File. ' + GetErrorMessage);

  KeySize := RSA_size(rsa);

  // Should be free if exception is raised
  rsa_in := OPENSSL_malloc(KeySize * 2);
  rsa_out := OPENSSL_malloc(KeySize);

  // Read the input data
  rsa_inlen := BIO_read(cleartext, rsa_in, KeySize * 2);
  if rsa_inlen <= 0 then
    raise Exception.Create('Error reading input Data.');
  rsa_outlen := RSA_private_encrypt(rsa_inlen, rsa_in, rsa_out, rsa, padding);
  if rsa_outlen <= 0 then
    raise Exception.Create('RSA operation error. ' + GetErrorMessage);

  BIO_write(crypted, rsa_out, rsa_outlen);
  RSA_free(rsa);
  BIO_free(cleartext);
  BIO_free_all(crypted);
  if rsa_in <> nil then
    OPENSSL_free(rsa_in);
  if rsa_out <> nil then
    OPENSSL_free(rsa_out);
  FreeOpenSSL;
end;

function RSAEncryptBlock(const AInputBlock: string; ApRSA: pRSA; const APadding: Integer = RSA_PKCS1_PADDING): string;
var
  KeySize: Integer;
  rsa_in, rsa_out: Pointer;
  rsa_inlen, rsa_outlen: Integer;
begin
  Result := '';
  KeySize := RSA_size(ApRSA);
  //-----------------------------------
  rsa_in := OPENSSL_malloc(Length(AInputBlock) + 1);
  rsa_inlen := Length(AInputBlock);
  rsa_out := OPENSSL_malloc(KeySize);
  //-----------------------------------
  // Read the input data
  CopyMemory(rsa_in, Pointer(AInputBlock), rsa_inlen);
  if rsa_inlen <= 0 then
    raise Exception.Create('Error reading input Data.');
  rsa_outlen := RSA_private_encrypt(rsa_inlen, rsa_in, rsa_out, ApRSA, APadding);
  if rsa_outlen <= 0 then
    raise Exception.Create('RSA operation error. ' + GetErrorMessage);

  SetLength(Result, rsa_outlen);
  CopyMemory(Pointer(Result), rsa_out, rsa_outlen);
  //-----------------------------------
  if rsa_in <> nil then
    OPENSSL_free(rsa_in);
  if rsa_out <> nil then
    OPENSSL_free(rsa_out);
end;

function RSAEncryptStr(const AKeyFile, APassword, AInputStr: string; const APadding: Integer = RSA_PKCS1_PADDING): string;
var
  rsa: pRSA;
  InLength, BuffSize: Integer;
  Key: pEVP_PKEY;
  i: Integer;
begin
  Result := '';
  InitOpenSSL;
  Key := ReadPrivateKey(AKeyFile, APassword);
  rsa := EVP_PKEY_get1_RSA(Key);
  EVP_PKEY_free(Key);
  if rsa = nil then
    raise Exception.Create('Error getting RSA key. ' + GetErrorMessage);
  BuffSize := RSA_size(rsa) - 11;
  InLength := Length(AInputStr);
  //-----------------------------------
  for i := 0 to (InLength div BuffSize) - 1 + IfThen(InLength mod BuffSize > 0, 1) do
  begin
    Result := Result + RSAEncryptBlock(Copy(AInputStr, i * BuffSize + 1, BuffSize), rsa, APadding);
  end;
  //-----------------------------------
  RSA_free(rsa);
  FreeOpenSSL;
end;

function RSADecryptBlock(const AInputBlock: string; ApRSA: pRSA; const APadding: Integer = RSA_PKCS1_PADDING): string;
var
  KeySize: Integer;
  rsa_in, rsa_out: Pointer;
  rsa_inlen, rsa_outlen: Integer;
begin
  Result := '';
  KeySize := RSA_size(ApRSA);
  //-----------------------------------
  rsa_in := OPENSSL_malloc(Length(AInputBlock) + 1);
  rsa_inlen := Length(AInputBlock);
  rsa_out := OPENSSL_malloc(KeySize);
  //-----------------------------------
  // Read the input data
  StrPCopy(rsa_in, AInputBlock);

  if rsa_inlen <= 0 then
    raise Exception.Create('Error reading input Data.');
  rsa_outlen := RSA_public_decrypt(rsa_inlen, rsa_in, rsa_out, ApRSA, APadding);
  if rsa_outlen <= 0 then
    raise Exception.Create('RSA operation error. ' + GetErrorMessage);

  SetLength(Result, rsa_outlen);
  CopyMemory(Pointer(Result), rsa_out, rsa_outlen);
  //-----------------------------------
  if rsa_in <> nil then
    OPENSSL_free(rsa_in);
  if rsa_out <> nil then
    OPENSSL_free(rsa_out);
end;

function RSADecryptStr(const AKeyFile, AInputStr: string; const APadding: Integer = RSA_PKCS1_PADDING): string;
var
  rsa: pRSA;
  InLength, BuffSize: Integer;
  Key: pEVP_PKEY;
  i: Integer;
begin
  Result := '';
  InitOpenSSL;
  Key := ReadPublicKey(AKeyFile);
  rsa := EVP_PKEY_get1_RSA(Key);
  EVP_PKEY_free(Key);
  if rsa = nil then
    raise Exception.Create('Error getting RSA key. ' + GetErrorMessage);
  BuffSize := RSA_size(rsa) - 11;
  InLength := Length(AInputStr);
  //-----------------------------------
  for i := 0 to (InLength div BuffSize) - 1 + IfThen(InLength mod BuffSize > 0, 1) do
  begin
    Result := Result + RSADecryptBlock(Copy(AInputStr, i * BuffSize + 1, BuffSize), rsa, APadding);
  end;
  //-----------------------------------
  RSA_free(rsa);
  FreeOpenSSL;
end;

end.

